Chip 2000 November/Chip Kasım 2000.iso/prog/share/11/setup.exe/%MAINDIR%/DEMOS/CIHTTP/HTTPEXP/files.bas

BASIC Source File | 2000-09-07 | 9.5 KB | 260 lines

Attribute VB_Name = "FileSystem"
'--------------------------------------------------------
'<Purpose> provides support for the local file system
'--------------------------------------------------------

Option Explicit

'----------------------------------------------------------------
'<Purpose> returns the appropriate image number for a drive type
'----------------------------------------------------------------
Public Function GetDriveImage(DriveLetter As String) As Integer
    Dim LegalDrive As String

    LegalDrive = DriveLetter & ":\"

    '---- some drives are not supported here
    Select Case GetDriveType(LegalDrive)
        Case DRIVE_CDROM
            GetDriveImage = imgCDRom
        Case DRIVE_FIXED
            GetDriveImage = imgDriveNotShared
        Case DRIVE_REMOTE
            GetDriveImage = imgNetDrive
        Case DRIVE_REMOVABLE
            GetDriveImage = imgFloppyDrive
        Case Else
            GetDriveImage = DRIVE_UNIDENTIFIED
    End Select

End Function

'------------------------------------------------------------
'<Purpose> removes a recently disconnected network drive
'------------------------------------------------------------
Public Sub RemoveNetDrive(ThisExplorer As Form, ParentNode As Node)
    Dim WorkingNode     As Node
    Dim i               As Integer
    Dim DriveImage      As Integer
    Dim NumberChildren  As Integer
    Dim DriveLetter     As String * 1

    NumberChildren = ParentNode.Children
    For i = 1 To NumberChildren
        If (i = 1) Then
            Set WorkingNode = ParentNode.Child
        Else
            Set WorkingNode = WorkingNode.Next
        End If

        '---- calculate the drive letter
        DriveLetter = Mid(WorkingNode.Text, 2, 1)
        DriveImage = GetDriveImage(DriveLetter)

        '---- see if the drive is unidentified, and remove it
        If (DriveImage = DRIVE_UNIDENTIFIED) Then
            Call ThisExplorer.Tree.Nodes.Remove(WorkingNode.Key)

            '---- also remove the extra data
            Call ThisExplorer.Attachments.Remove(WorkingNode.Key)

            Exit Sub
        End If
    Next

    Set WorkingNode = Nothing
End Sub

'------------------------------------------------------------
'<Purpose> populates the ListView with local files
' under a directory
'------------------------------------------------------------
Public Sub AddLocalFiles(ThisExplorer As Form, ParentNode As Node)
    Dim TheseItems      As ListItems
    Dim WorkingItem     As ListItem
    Dim FileAttr        As Integer
    Dim FileName        As String
    Dim FileType        As String
    Dim FullPathName    As String
    Dim StartingDir     As String

    ThisExplorer.MousePointer = vbHourglass

    On Error GoTo BadItem

    '---- cache the ListItems collection
    Set TheseItems = ThisExplorer.List.ListItems

    StartingDir = ThisExplorer.Attachments(ParentNode.Key).DrivePath
    FileName = Dir(StartingDir)

    Do While (FileName <> "")
        If ((FileName <> ".") And (FileName <> "..")) Then
            FullPathName = StartingDir & FileName

            FileAttr = GetAttr(FullPathName)            ' Get Files Attributes...
            If (FileAttr <> vbDirectory) Then
                '---- add file to ListView
                Set WorkingItem = TheseItems.Add(, FullPathName, FileName, imgLocalFile, imgLocalFile)
                FileType = "File"
            Else
                '---- add directory to ListView
                Set WorkingItem = TheseItems.Add(, FullPathName, FileName, imgFolderClosed, imgFolderClosed)
                FileType = "File Folder"
            End If

            '---  add type, size, and modified bits
            WorkingItem.SubItems(1) = Str(FileLen(FullPathName) \ 1024) & "KB"
            WorkingItem.SubItems(2) = FileType
            WorkingItem.SubItems(3) = Format(FileDateTime(FullPathName), "General Date")
        End If

NextDir:
        '---- dir with no arguments gets next file, or directory
        FileName = Dir
    Loop

Cleanup:
    On Error GoTo 0
    Set TheseItems = Nothing
    Set WorkingItem = Nothing
    ThisExplorer.MousePointer = vbDefault
    Exit Sub

BadItem:
    Resume NextDir
End Sub

'------------------------------------------------------------
'<Purpose> populates the TreeView with local directories
' under a particular drive or directory
'------------------------------------------------------------
Public Sub AddLocalDirs(ThisExplorer As Form, ParentNode As Node)
    Dim TheseItems      As ListItems
    Dim WorkingItem     As ListItem
    Dim WorkingNode     As Node
    Dim TheseNodes      As Nodes
    Dim FileAttr        As Integer
    Dim DirName         As String
    Dim FullPathName    As String
    Dim NodeKey         As String
    Dim StartingDir     As String

    ThisExplorer.MousePointer = vbHourglass

    On Error GoTo BadNode

    '---- cache nodes and list items collections
    Set TheseNodes = ThisExplorer.Tree.Nodes
    Set TheseItems = ThisExplorer.List.ListItems

    TheseItems.Clear

    StartingDir = ThisExplorer.Attachments(ParentNode.Key).DrivePath

    '---- get all directories under the starting directory
    DirName = Dir(StartingDir, vbDirectory)
    Do While (DirName <> "")
        '---- ignore current and previous directories
        If ((DirName <> ".") And (DirName <> "..")) Then
            FullPathName = StartingDir & DirName
            FileAttr = GetAttr(FullPathName)
            If (FileAttr = vbDirectory) Then
                NodeKey = ParentNode.Key & "." & DirName

                If (Not IsKeyed(TheseNodes, NodeKey)) Then
                    '---- add the node to the tree
                    Set WorkingNode = TheseNodes.Add(ParentNode, tvwChild, NodeKey, DirName, imgFolderClosed, imgFolderOpen)

                    '---- also create and add attachment
                    Dim ThisAttachment As New Attachment
                    ThisAttachment.NodeType = nodLocalDrive
                    ThisAttachment.DrivePath = StartingDir & DirName & "\"
                    Call ThisExplorer.Attachments.Add(ThisAttachment, NodeKey)
                    Set ThisAttachment = Nothing

                    '---- add searching placeholder
                    Call TheseNodes.Add(WorkingNode, tvwChild, WorkingNode.Key & nodPlaceHolder, nodPlaceHolder, imgPlaceHolder)
                End If

                '---- add directory to ListView; pad with invisible char for sorting purposes
                Set WorkingItem = TheseItems.Add(, NodeKey, Chr(160) & DirName, imgFolderClosed, imgFolderClosed)
                '---  add type, size, and modified bits to item
                'WorkingItem.SubItems(1) = Str(FileLen(FullPathName) \ 1024) & "KB"
                WorkingItem.SubItems(2) = "File Folder"
                WorkingItem.SubItems(3) = Format(FileDateTime(FullPathName), "General Date")
            End If
        End If
        '---- dir with no arguments gets next file, or directory
        DirName = Dir
    Loop

Cleanup:
    On Error GoTo 0
    Set TheseItems = Nothing
    Set TheseNodes = Nothing
    Set WorkingItem = Nothing
    Set WorkingNode = Nothing
    ThisExplorer.MousePointer = vbDefault
    Exit Sub

BadNode:
    GoTo Cleanup
End Sub

'------------------------------------------------------------
'<Purpose> populates the TreeView with local drives
'------------------------------------------------------------
Public Sub AddLocalDrives(ThisExplorer As Form, ParentNode As Node)
    Dim DriveImage      As Integer
    Dim DriveID         As Long
    Dim TheseNodes      As Nodes
    Dim WorkingNode     As Node
    Dim DriveLetter     As String * 1
    Dim NodeKey         As String
    Dim ParentKey       As String

    ThisExplorer.MousePointer = vbHourglass

    '---- errors can be generated from duplicate keys; ignore
    On Error Resume Next

    '---- cache nodes collection
    Set TheseNodes = ThisExplorer.Tree.Nodes

    ParentKey = ParentNode.Key & "."

    For DriveID = Asc("A") To Asc("Z")
        DriveLetter = Chr(DriveID)
        NodeKey = ParentKey & DriveLetter

        If (Not IsKeyed(TheseNodes, NodeKey)) Then
            DriveImage = GetDriveImage(DriveLetter)

            If (Not (DriveImage = DRIVE_UNIDENTIFIED)) Then
                '---- add the node to the tree
                Set WorkingNode = TheseNodes.Add(ParentNode, tvwChild, NodeKey, "(" & DriveLetter & ":" & ")", DriveImage)

                '---- also create and add attachment
                Dim ThisAttachment As New Attachment
                ThisAttachment.NodeType = nodLocalDrive
                ThisAttachment.DrivePath = DriveLetter & ":\"
                Call ThisExplorer.Attachments.Add(ThisAttachment, NodeKey)
                Set ThisAttachment = Nothing

                '---- add searching placeholder
                Call TheseNodes.Add(WorkingNode, tvwChild, WorkingNode.Key & nodPlaceHolder, nodPlaceHolder, imgPlaceHolder)
            End If
        End If

    Next DriveID

Cleanup:
    On Error GoTo 0
    Set TheseNodes = Nothing
    Set WorkingNode = Nothing
    ThisExplorer.MousePointer = vbDefault
End Sub